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15-SEP=1 3:39:0 AX/VMS Macro V04-00 Page 1 
6-SEP-19 3B %; 38; o¢ EBASRIL. SRCIBASMATADD. MAR; 1 ° (1) 
-TITLE BASSMAT_ADD 
SIDENT /1-017/7 ; File: BASMATADD.MAR Edit: 0G1017 


ARAAARRRRRRRRRSRRAASALALALELL ALES ESAS EEE REESE TERE CEES ESE CEC eee ae) 


COPYRIGHT (c) 1978, 1980, 1982, 1984 B 
DIGITAL EQUIPMENT CORPORATION, MAYNARD. MASSACHUSETTS. 
ALL RIGHTS RESERVED. 


*® 

® ® 
*® i 
*® ® 
* & 
® ® 
;* THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED 
* ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE 
is INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR OTHER * 
:* COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY © 
;* OTHER PERSON, NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ®* 
:® TRANSFERRED. . 
*® ® 
# THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE + 
;* AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ® 
:® CORPORATION. ‘ 
: © 
*® ® 
** e 
*® ® 
*® ® 
® ® 


DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 
SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 


: PARRAAARARAAAASEAEAEESAAAASRELASEEESASESASESESESELESLERECE EES E SOS ECE CEC ee aS 
+ 

FACILITY: BASIC code support 

ABSTRACT: 


This module acds 2 arrays of any dtype and stores the result in a 
third array. 


ENVIRONMENT: User Mode, AST Reentrant 


AUTHOR: R. Will, CREATION DATE: 18-Jun-79 
MODIFIED BY: 
ae 


- Original 
1- 3 - Sete IV flag in entry mask. RW 22-Oct-79 
- Add dtypes byte, g and h floating. PLL 11-Sep-81 
4 =- More modifications for new data a RES +56 a 24-Sep-81 
5 = Changed external references to G* 5-Sep-81 
6 - Substitute a macro for the calls to A. array fetch and store 
routines. This should speed things up. PLL 6-Nov-81 
7 = STORE macro must be modified to handle g & h le eine. a 11-Nov-81 
8 - Reserve space on stack for hfloat source. PLL 1 
9- correst a rete expression in the FETCH and STORE. me ie 
Jan-8 
0 - Correct area. STORE again. PLL “terhares 
1 = Don't List macro expansions. PLL 16-Mar-82 
§ - Fix CASEB statements. PLL 13-Apr-82 
= Remove FETCH and STORE macros; they are now located in macro 


aa ee 
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‘ierery i XMAC.OLB. Add code to support arrays of descriptors. 
-Jun- 

Change own storage to stack storage. LEB 9-Jul-1982 

Allow gfioat foownts to 1382 stored in a double destination, and 
vice versa. -Oct-1 

Use G* for Abb externals. Don't List macro expansions. 

SBL 16-Nov-1 

Correct stack offsets when storing in LONG array. DG 10-Jan-1984 
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6-SEP-1984 95:38:04 EBASRIL. SREIBASH TADD .MAR;1 - 3) 
«SBTTL DECLARATIONS 


INCLUDE FILES: 


OO 


eEXTRN Ht th ae ert array element store for word 


° 0 

0 SOSCDEF ; define descriptor offsets 
33 4 SSF DEF ; use to get scale 

00 fe 
000 $ ; EXTERNAL DECLARATIONS: 

6008 
$09 0 -DSABL GBL Prevent unde lared 

000 1 symbols from being 
0000 ¢ automatically 9! al. 
0000 -EXTRN BASSK_ARGDONMAT signalled if al 3 blocks 
0000 4 not present in array desc 
0000 5 or dimct = 
0000 $ -EXTRN BASSK_DATTYPERR signalled if dtype of arra 
0000 isn’t word long float double 
0000 8 -EXTRN BASSK_MATDIMERR signalled if # of dims on 
0000 9 source arrays don't agree 
0000 0 -EXTRN BASSK_ARRMUSSAM signalled if upper and lower 
0000 bnds not same on src arrays 

4 


MATRIXMAC.OLB. 
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0000 ~-EXTRN BASSSTO_FA_L_R8 ; array element store for long 
0000 -EXTRN BASSSTO_FA_F_R8 ; array element store - float 
ASSSTO_FA_D_R8 ; array element store = double 
0000 -EXTRN BASSSTO_FA_B_R8 ; array element store - byte 
0000 -EXTRN BASSSTO_FA_G_R8 ; array element store - gfloat 
0000 8 -EXTRN BASSSTO_FA_H_R8 ; array element store - hfloat 
0000 9 -EXTRN BASSFET_FA_W_R8 ; array element fetch - word 
0000 100 EXTRN BASSFET_FA_L_RB8 3 array element fetch - long 
0000 101 -EXTRN BASSFET_FA_F_R8 3 array element fetch - float 
0000 1 ¢ ~-EXTRN BASSFET_FA_D_R8 3; array element fetch - double 
0000 1 -EXTRN BASSFET_FA_B_R8 ; array element fetch - byte 
0000 104 ~-EXTRN BASSFET_FA_G_R8 i; array element fetch - gfloat 
0000 105 -EXTRN BASSFET_FA_ HRB : array element fetch - Afloat 
0000 «(1 $ -EXTRN BASSMAT_REDIA ; check if redimensioning of 
0000 (1 ; dest array is necessary, if 
0000 108 ; so, do it 
0000 109 -EXTRN BASSSSCALE_R1 : scale for double procision 
0000 110 -EXTRN MTHSDINT RG ; truncate dbl precision number 
8208 111 -EXTRN BASSSSTOP i signal fatal errors 
4 1 ¢ -EXTRN BASSFETCH_DESC ; fetch addr of descriptor 
0000 1 -EXTRN BASSFETCHBFA 
0000 114 -EXTRN BASSSTORE_BFA 
4 115 ; 
boo 1 § : MACROS: 
00 117; 
000 1 3 
000 119; SBASSMAT_ADD add loop algorithm, see next page é 
B85 120 ; FETCH etch an element from an array ‘found in macro Library 
0 121 ; MATRIXMAC.OLB. : } 
0 ' § 3 STORE store an element into an array (found in macro Library 
124 ° 


oo 
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Val DECLARATIONS B-SEp=1986 0:28.07 LBASRTL SAE IoASMATAOD.MaR;1 2% 5) 
125 ; 
! § 3; EQUATED SYMBOLS: 
1 oe 
0 0 1 ’ lLower_bnd2 = 0 ; stack offset for temp 
09 4 130 lower_bndil = 4 ; stack offset for temp 
0 8 131 upper_bndi = ; stack offset for temp 
$8 C 1 save_srcl = 1 ; stack offset for temp 
: 1¢ 00 1 value_desc = 28 ; define an output desc 
00001C 00 1 str_len = 28 ; length field within desc 
OOOO01E 135 dtype = 39 ; data type field in desc 
0 dha 1 § class = 31 :; class field in desc 
0 0 1 pointer_= 32 3; pointer to DATA 
0000024 138 ata = 36 3; data field (4 longwords) 
4444 8 0000 139 dsc$i_l1_1 = 3h ; desc offset if 1 sub 
0001C 0000 140 dsc$l_ul_1 = 28 ; desc offset if 1 sub 
0000001C 0000 141 dsc$l_l1_2 = $3 ; desc offset if 2 sub 
a er RS | aete SH UT ts 
sc$l_l2_2 = 3 desc offset Su 
00000028 0000 144 oeeS tras: = 40 ; desc offset if 2 sub 
$383 1a 
0000 147 ; OWN STORAGE: 
0000 148; 
0000 149 
0000181 
: DECLARATIONS: 
$333 1ag sec 
00000000 154 -PSECT _BASSCODE PIC, USR, CON, REL, LCL, SHR, - 
0000 155 EXE, RD, NOWRT, LONG 
0000 156 
0000 =«157 
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39 

; This macro contains the looping mechanism for accessing all elements of 

; an array. It also contains all the logic for all the combinations of data 

; types and scaling. A macro is used to make it easy to maintain the parallel 
; code for all the different data types. 


5 -MACRO SBASSMAT_ADD srcl_dtype, src2_dtype ; add algorithm 


3° 
; hoop throu h all the rows. Row and column upper and lower bounds have been 
: initialized on the stack. 


LOOP_1ST_ SUB’srcl_dtype'src2_dtype': 
MOVL 9 ) "Rit 


2 
Lower _bnd2(SP), ; R11 has 2nd lower bound 


; Loop through all the elements (columns) of the current row. Column lower 
; bound is initialized in R11. Column upper bound is on the stack. 

; Distinguish array by data type so that the correct fetch routine can 

3; retrieve the data, the correct add can be done and the correct 

3; store routine can be called. 


LOOP_2ND_SUB'srcl_dtype'src2_dtype': 
3¢ 
; Get the data from the first source array 


MOVL srcl_matrix(AP), RO 
MOVL lower wheats R1 


R11, 
FETCH $0ch gtype" 
MOV'srci_dtype’ RO, save_src1(SP) 


3; pointer to Ist src array 

3; current row 

3; current col 

3 fetch data from srcl array 
3 store the Ist array element 


3¢ 
; Get the data from the second source array 


MOVL src2_matrix(AP), RO 
MOVL lower _bnd1(SP), R1 
MOVL ae 

FETCH ‘src2_dtype’ 


pointer to 2nd src array 
current row 

current col 

fetch data from src2 array 


f the data types of the 2 source arrays is the same, do the arithmetic 
n that data type. Else convert the data to a common type and add. 

If scaling is needed (ie if at least one but not both of the arrays is 
double) convert integer to double. (Note that the integerize is not 
necessary because only integers (not float) can be converted to double, 
and the sum of 2 integers is guaranteed to be integer). 


i IDN srcl_dtype, src2_dtype ; src arrays are 
; same data type 
ADD'srci_dtype'2 save_srci(SP), rd ; add the source elements 
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| 6 1g osey DEST_CASE_‘srcl_dtype’ 3 go to store in dest 
18 IF IDN srcl_dtype. H ; source 1 is hfloat 
0 1 bes gree Stree » RO 
0 0 ADDH Save_srci(SP), RO. 
| 90 1 BSBy DEST-CASE_H 
00 : If ION src2_dtype, H ; is 2nd source hfloat 
00 4 CVT'srcl_dtype'H save_srci(SP), R2 
000 5 3; ¢vt source 1 to hfloat 
000 § ADDH2 R2, RO 
999 f BSBW DEST_CASE_H 
44 9 IF IDN srci_dtype, G ; source 1 is gfloat 
0000 0 IF IDN src2_dtype, D ; special case gfloat + dbl 
9009 31 CVT'srcl_dtype'H save_srci(SP), R& ; romote both operands to 
; oa 
3208 35 CvT'src2 gtype'e RO, RO 
4 4 ADDH2 = R4, RO 
494 3 O5eu DEST_CASE_H 3 go to store the dest 
0000 3 CVT'src2_dtype'G RO, RO ; cvt source 2 to gfloat 
0000 8 ADDG2 sSave_srci(SP), RO 
444 ip aaa DEST_CASE_G 
0000 41 LFF 
0000 os IF IDN src2_dtype, G ; is source 2 gfloat 
0000 4 IF IDN srcl_dtype, D ; special case dbl + gfloat 
0000 244 CVT'srcl_dtype'H Save_srci(SP), R& ; promote both operands to 
0000 45 : hfloat 
0000 46 CVT*src2_dtype'H RO, RO 
0009 47 ADDH2 
st $8 mt] DEST_CASE_H 3: go to store the dest 
0000 50 CVT'srci_dtype'’G save_srci(SP), R2 
0000 51 ; cvt source 1 to gfloat 
0000 28 ADDG2 R2, RO 
9464 37 eC DEST_CASE_G 
$000 55 LFF i src arrays different dtype 
0000 2$ IF IDN srci_dtype, D ; source 1 is double 
0000 5 z: (mo need to check for gfloat 
0000 58 : because that case is handled 
8 38 59 ; above) 
60 CvT'src2_dtype'D RO, -(SP) 3 cvt array2 to double & save 
0000 261 MOVL SFSU SAVE_FPCFP), RO : pass FP to get scale 
3 6 G*BASSSSCALE_R1 ; get scale in RO 
0 6 : call a BLISS routine because 
00 64 ; the frame offsets are only 
sit 65 3; defined for BLISS 
0 6 MULD2 (SP)+, RO ; scale 2nd element 
00 6 JSB G*MTHSDINT_R4 ; integerize 
oe ADDD2 = save_srci(SP), RO ; add Tst element & scaled 2nd 
0 § BSBw DEST_CASE_D 3 cvrt double sum to dest type 
? LFF : Ist_array not double 
. src2_dtype, ; is 2nd src double 
7 IF 10N 2_d Dd is 2nd doub| 
VT'srcl_dtype save_src . Save_src 
0 72 CvT° 1d *D 1(SP) 1(SP) 
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0 7 3; yes, make srcl double & save 
3 7 MOVD RO, -(SP) 3; save the data 
7 MOVL  SFSL_SAVE_FP(FP), RO ; pass FP to get one 
0 7 JSB G*BASSSSCALE_R1 : get scale in RO 
0 7 3; call a BLISS routine because 
7 3 the frame ot isers are only 
S 3 defined for BLI 
MULD2 save _srcl+8(SP), RO 3; scale, (+8 because src2 is 
0 : double and saved on stack 
000 JSB GeMTHSDINT uR4 ; integerize 
00 ADDD2 (SP)+, RO ~ 3 compute the sum 
99 SBW  -dDEST_CASE_D ; cvrt double sum to dest type 
7 IFF : no double operands try float 
0000 olf IDN srcl -dtype. F : is Ist element float 
0000 CVT'sre2 _dtype'F 0, RO : make 2nd element float 
0000 ADDF2 save_srci(SP), RO : add 
0000 BSBW DEST_CASE_F i; cvrt float sum to dest type 
444 o1FF 3; 1st_array not float 
000 Mm src2_dtype, F ; is 2nd array float 
0000 CvT'srcl Stype'f save_srci(SP), Ri; yes-make Ist element float 
0000 DoF2 =R 0 : add 
0000 BSBW DEST_CASE F ; cvrt float sum to dest type 
0000 LFF ; no double or float, try long 
0000 If IDN srci_dtype, L ; is Ist array long 
0000 CvT'src2_dtype' 3; make 2nd element long 
0000 ADDL2 save_srci(SP), RO : add 
444 9 4 1 DES SE_ 3; convrt long sum to dest type 
0000 01 IF IDN src2_dytpe, L ; source 2 is long 
0000 ¢ CVT'srcl_dtype'L save_srci(SP), Ri; cvt srcl to Long 
0000 ADDL2 . ; add 
0000 4 BSBW DEST_CASE_L 3; convrt long sum to dest type 
0000 5 o1FF 
0000 6 IF IDN srcl ~dtype. B 3; source 1 is byte 
0000 307 CVT'src2_dtype'B 3; cvt source 2 to byte 
0000 308 ADDB2 Save_srci(SP), RO 
0000 09 BSBW DEST-CASE_B 
Bp 10 LFF 
00 11 CVT'srci_dtype'B save_srci(SP), R1 
0000 \ 3; src2 must be byte, so cvt srcl 
0000 1 ADDB2 R1, RO 
0000 314 BSBW =: DEST_CASE_B 
0000 314 EnDc 
$000 19 ~ENDC 
0000 18 -ENDC 
44 1 -ENDC 
000 0 -ENDC 
38 1 -ENDC 
0 § -ENDC 
0000 -ENDC 
0000 4 -ENDC 
4 5 -ENDC 
00 $ .ENDC 
099 ‘ -ENDC 
26 
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; Have stored that element. Now see if it was the last column. If not, 
3 continue with the next column. Otherwise continue to next row. 


INCL R11 i; get next column 

cork git RO ; see if Last column done 

BRW LOOP_2ND_SUB'srcl_dtype'’src2_dtype’ ; no, continue inner loop 
> Have completed entire row. See if it was the last row. If not, 
3 continue with next row. 
5$: INCL Lower_bnd1 (SP) ; get next row 

aa sayer Ane CSP? upper_bnd1(SP) ; see if last row done 

BRW LOOP_1ST_SUB’srci_dtype'src2_dtype’ ; no, continue outer Loop 
10$: RET i yes, finished 

ENDM 
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; aa -SBTTL BASSMAT_ADD = Add 2 arrays giving a third 
5 ; FUNCTIONAL DESCRIPTION: 
: 3 Add 2 arrays givin a third. Signal an error if the 2 arrays to be 
8 : added do not have the same number 9 dimensions and the same 
4 59 ; upper and lower bounds for those dimensions. Redimension the output 
0 60 ; orcey to have the same upper bounds as the input arrays. 
00 61 ; Init ot tse all the necessary 
00 6¢ 3 Looping information on the stack. Conversions may have to be done 
00 65 ; so that the sources are the same data type, so divide 
4 64 ; the looping portion according to the data types. Conversion to the 
0 65 ; correct destination data type will be done by a JSB to a routine, 
B28 6 3 instead of multiplying the number of possible combinations by 4. 
44 | 3; CALLING SEQUENCE: 
44 79 3 CALL BASSMAT_ADD (srcl_array.rx.da, src2_array.rw.da, dest_matrix.wx.da) 
0000 ie 3; INPUT PARAMETERS: 
0000 73; 
00000004 0000 74 srci_matrix = 4 
00000008 0000 75 src2_matrix = 8 
0000 6 ; 
44 AA 3; IMPLICIT INPUTS: 
444 a 3 Scale from the callers frame to scale double precision. 
0000 381 3; OUTPUT PARAMETERS: 
0000 +f 3 
0000000C 0000 8 dest_matrix = 12 
0000 84 ; 
0000 85 ; IMPLICIT OUTPUTS: 
a4 $6 : 
000 3 NONE 
0000 388 ; 
0000 89 ; FUNCTION VALUE: 
0000 90 ; COMPLETION CODES: 
0000 91; 
0000 92 ; NONE 
0000 93 ; 
i464 ae : SIDE EFFECTS: 
444 96 ; This routine calls the redimensioning routine and the array element 
00 97; fetch and store routines and therefore may signal any of their errors. 
0000 98 ; It may also signal any of the errors Listed in the externals section. 
B88 138 3 It may also cause the destination array to have different dimensions. 
$000 401 ;-- 
3 40 
GFFC 000 $87 ENTRY BASSMAT_ADD, “M<R2,R3,R4,R5,R6,R7,R8,R9,RIO,R11,1V> 
009 405 ;+ 
4 $ : REGISTER USAGE 
00 407 ; RO - R8& destroyed by store routines 
00 408 ; R9 upper bound for 2nd subscript 
00 409 ; R10 pointer to dest array descriptor 
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ey BASSMAT_ADD = Add 2 arrays giving a thi rai iet} 7 13:38.01 YBASRIL. SRC IBASMATADD.MAR: 1 . (4) 
0 $19 3 R11 current value of 2nd subscript 
tig 
0 4135 3+ 
0 414 ; Put routine arguments into registers for ease of use. 
o3 cig :; If block 2 of array descriptor (multipliers) is not present then error. 
002 417° 
2 O4A DO 000 418 MOVL srci_matrix(AP), %2 : ptr to srcl array descr 
1F OA A2 O E1 0006 419 BBC #DSCSV_FL_BOUNDS, DSC$B_AFLAGS(RD)> ERR_ARGDONMAT , 
00B 420 3 exit if block 3 not 
se 421 3 present in descriptor 
3 O08 AC 00 0008 4 ¢ MOVL src2_matrix(AP), R3 ; ptr to src2 array descr 
16 OA A3 E1 OOOF 4 BBC #DSCSV_FL_BOUNDS, DSC$B_AFLAGS(R3), ERR_ARGDONMAT 
Bae 424 ; exit Tf block 3 not 
014 425 i: present in descriptor 
5A OC AC DO Bote 426 MOVL dest_matrix(AP), R10 3; ptr to dest descriptor 
Ur 18 427 CLRQ =(SPY 3 save space for DATA 
7E 7C QOO1A 428 CLRQ -(SP) $ an 
7E 7C OO1C 429 CLRQ -(SP) 3; VALUE_DESC 
7E 7C OO1E 430 CLRQ -(SP) 3; reserve space to save srcl 
7E 7C 0020 431 CLRQ -(SP) : srcl may be hfloat 
B0s$ $36 
00 433 ;+ 
b055 434 ; Set up Limits for looping through all elements 
00 § 435 ;- 
002 436 
01 OB A2 91 0022 437 CMPB DSCSB_DIMCT(R2), #1 ; determine # of subscripts 
OF 13 0026 438 BEQLU INIT_ONE_SUB : 1 sub, go init — 
59 1A 0028 439 BGTRU INIT_TWO_SUBS 3 >=2 subs, go init 
002A 440 : 0 subs, fall into error proc 
002A 441 
002A ade ERR_ARGDONMAT : 
00000000"8F DD O02A 44 PUSHL #BAS$K_ARGDONMAT : signal error, 0 for dimct 
00000000'GF 01 FB 030 rr CALLS #1, G*BAS$SSTOP 3; or block 2 or 3 absent 
0037 446 ;+ 
0037 447 ; There is only 1 subscript. Redimension the destination array. 
0037 448 ; Make both uoger and lower bound for 2nd : 
0037 449 ; subscript a 1. A second subscript will be passed to and ignored by the 
ba o29 3; store routine. Put bounds for ist subscript on stack. 
$039 13g 
oO 3s 453 INIT_ONE_SUB: 
0B AS «(01S o91 (0037) = 454 CMPB #1, DSCSB_DIMCT(R3) ; do src arrays have same 
Hits 455 3 number of dimensions 
2c 12 $38 456 BNEQU ERR_MATDIMERR ; no, error 
10 AS. 1C A291 «—003D = 457 CMPB dsc$l_ul_1(R2), dsc$l_u1_1(R3) ; do src arrays have the same 
943 $38 : upper bounds 
-_. 4 45 BNEQU ERR_ARRMUSSAM 3; no, error 
18 AS 18 A2 91 ire: 460 CMPB =—s dsc S$L_L1_1¢R2), dsc$l_l1_1(R3) ; do src arrays have the same 
049 461 : lower bounds 
28 12 0049 $96 BNEQU ERR_ARRMUSSAM ; no, error : 
1C A DD 4B 46 PUSHL dsc$l_u1_1(R3) ; get bound for redim 
A 0D f 464 PUSHL ; pointer to dest array desc 
00000000 ' GF 3 FB 5 465 CALLS #2, G*BASSMAT_REDIM : redimension the dest 
1C A DD 0057 466 PUSHL dsc$l_ul_1(R37 : 1st upper bound 
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1-017 BASSMAT_ADD = Add 2 arrays giving a thi 6=-SEP-1984 93:38:04 EBASRTL. SREIGASMATADD MAR: 1 . (4) 
18 A DD SA 467 PUSHL sc$l_li_1(R3) : Ist lower bound 
: 14 Bah $38 BGTR ¢§ waiilar: ; not 0 or neg, do 2nd sub 
6E 1 pO B25 6 MOVL #1, (SP) 3; don't alter col 0 
1 oD oe 470 1$ PUSHL #1 3 dummy éng upper bound 
59 1 00 006 471 MOVL #1, R9 ; dummy 2nd lower bound 
62. 11 067 ae BRB SEPARATE_DTYPES ; go loop 
4424 474 ERR_MATDIMERR: 
00000000°8F DD 0069 475 PUSHL #BAS$K_MATDIMERR ; Signal error, src arrays 
00000000'GF 01 FB A $78 CALLS #1, G*BASS$STOP : don't have same # dimensns 
th $28 ERR_ARRMUSSAM: 
Q0000000'8F ODD 760 «47 PUSHL #BASS$K_ARRMUSSAM 3; Signal error, src arrays 
00000000'GF 01 FB 444 480 CALLS #1, G*BASS$STOP 3 same bounds 
ee 
$083 288 ; There are 2 subscripts. Check and redimension the destination array if 
et 484 ; necessary. Put the upper bound for both subscripts on the 
008 485 ; stack and make sure that the lower bound for both subscripts will start 
0083 $36 3; at 1 (do not alter row or col 0) 
0083 487 ;- 
0083 488 
0083 489 INIT_TWO_SUBS: 
0B AS 02 91 0083 490 CMPB #2, DSCSB_DIMCT(R3) ; do src arrays have same 
0087 491 3; number of dimensions 
EO 12 0087 49 BNEQU ERR_MATDIMERR ; no, error 
20 AS 20 A2 91 0089 49 CMPB dsc$l_ul_2(R2), dsc$l_u1_2(R3) ; do src arrays have the same 
OO8E 494 : ist upper bounds 
12 OO8E 495 BNEQU ERR_ARRMUSSAM : no, error 
1C AS «61C A2 91 «0090 3864496 CMPB dsc$l_l1_2(R2), dsc$l_l1_2(R3) ; do src arrays have the same 
0095 497 ; 1st lower bounds 
D2 12 0095 498 BNEQU ERR_MATDIMERR 3 no, error 
28 AS) «628 A291 =—0097— 499 CMPB dsc$l_u2_2(R2), dsc$l_u2_2(R3) ; do src arrays have the same 
009c =: $00 ; end upper bounds 
D8 12 009C 501 BNEQU ERR_ARRMUSSAM : no, error 
24 A3 24 A2 91 009 208 CMPB dscSl_l2_2(R2), dsc$l_l2_2(R3) ; do src arrays have the same 
OOA 50 : end lower bounds 
D1 12 OOA 504 BNEQU ERR_ARRMUSSAM ; no, error 
28 AS DD OOAS 505 PUSHL dsc$l_u2_2(R3) ; 2nd upper bound 
20 AS DD OOAB 506 PUSHL dsc$l_ul_2(R3) ; 1st upper bound 
5A 0D QOAB 507 PUSHL 0 ; dest array pointer — 
00000000°GF 03 FB QOAD 508 CALLS #3, G*BASSMAT_REDIM 3 redimension destination 
3 DD 00B4 509 PUSHL qac$t vl _g(Rey ; 1st upper bound 
1¢ ry DD peer 219 PUSHL dsc$l_l1_2(R3) ; 1st lower bound 
0 14 QOBA 11 BGTR 1$ 3 not row 0 or ange do cols 
E 01 pO O0BC 216 MOVL #1, (SP) 3 start with row 
59 28 A3 DO OOBF 513 1$: MOVL Gsc$t ug g(R3). RO ; 2nd upper bound 
24 A353 DD Bate 514 PUSHL dsc$l-l2_2(R3) ; 2nd lower bound 
03 14 00C6 515 BGTR SEPARATE_DTYPES ; not col 0 or neg. go loop 
6— 01 00 00C8 218 MOVL #i, (SP) 3; start with col 
00CB é} 
00CB 18 ;+ : . 
bate i ; Algorithm now differs according to data types 
cB ee 
3 5 SEPARATE _DTYPES: 
05 06 02 A2 8F OOCB 523 4$: CASEB DSCSB_DTYPE(R2), #DSCSK_DTYPE_B, #<DSCSK_DTYPE_D - DSCSK_DTYPE_8> 
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a= 
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0037' 00D 4 2$ «WORD BYTE-2$ : code for byte dtype 
gESe, OD 5 «WORD WORD-2$ ; code for word dtype 
1€13° 00D4 § «WORD LONG-2$ ; code for long dtype 
+e 3p »WORD ERR_DATTYPERR-2$ 3 quad not supported 
A011’ 00D 8 «WORD FLOAT-2$ ; code for float dtype 
7EF* Boa 3 eWORD DOUBLE-2$ 3; code for double dtype 
1B «602 Ag 91 OD 1 CMPB Rees Pree ees #DSCSK_DTYPE_G 
0 12 OOE § BNEQ $ 
4600 31 43 Z BRW GFLOAT 
1c 02 ag 91 GOES 5 3$ CMPB SCSB_DTYPE(R2), #DSCSK_DTYPE_H 
0 12 434 6 BNEQ 
5408 31 poe 23f BRW HFLOAT 
18 02 A2 91 OQOEE 539 5$ CMPB DSC$B_DTYPE(R2), MDSCSK_DTYPE_DSC ; descriptors? 
06 12 OOF2 540 BNEQ ERR_DATTYPERR ; no = signal error 
52 04 A2 DO OOF4 541 MOVL 4(R2) ,R2 3 Store addr of desc in R2 
Di =6©11 «OOF8 226 BRB 4$ ; CASE again for dtype in desc 
OOFA 54 
OOFA 544 ERR_DATTYPERR: 
00000000°8F DD OOFA 545 PUSHL epasey DATTYPERR : Signal error, unsupported 
00000000'GF 01 FB 0100 546 CALLS . G*BASS$STOP 3 dtype in array desc 
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1-017 BASSMAT_ADD = Add 2 arrays giving a thi eet att t 9; 28: o¢ UBASRTL. SRE 5BAS MATADD.MAR; 1 “ (5 
107 49 i+ 
} f 29 ; Source array is a byte array. Differentiate on the destination type. 
107 ; i 
05 06 02 A3 ef 107 5 BYTE CASEB DSCSB_DTYPE(R3), M#DSCSK_DTYPE_B, #<DSCSK_DTYPE_D = DSCSK_DTYPE_B> 
002d" 010¢ 54 1$: «WORD BYTE_TO_BYTE-1$ 3; code for byté dtype 
0218" 01 55 -WORD BYTE_TO_WORD-1$ ; code for word dtype 
040C* 011 228 «WORD BYTE _TO_LONG-1$ 3; code for long dtype 
FFEE 011 22 «WORD ERR Pa hati 3 Quad not supported 
OSFD* 0114 58 «WORD BYTE_TO_FLOAT-1$ ; code for float dtype 
O7EE" Bie 222 «WORD BYTE_TO~ DOUBLES -1$ ; code for double dtype 
18 O02 A3 91 b118 26 CMPB DSC$B_DTYPE(R3), #DSCSK_DTYPE_G 
03 12 O11C 286 BNEQ 2s 
09E2 31 ite 263 BRW BYTE_TO_GFLOAT 
1¢ (02 03 «(91 6154 565 2$ CMPB = OSCS$B_DTYPE(R3), #DSCSK_DTYPE_H 
0 12 0125 566 BNEQ 3$ 
OBD2 31 SISA Ht BRW BYTE_TO_HFLOAT 
18 02 A3 91 O12A 569 3$ CMPB DSCS$B_DTYPE(R3), #DSCSK_DTYPE_DSC 
06 12 pie 570 BNEQ 4$ 
53 04 A3 DO 0130 571 MOVL 4(R a} R3 ; R3 <== addr of descriptor 
os bi 276 BRB BYT ; CASE again for dtype in desc 
FFC1 31 0136 574 4$: BRW ERR_DATTYPERR 3 unsupported dtype 
0139 «575 
0139 576 ;+ 
0139 577 ; Use the macro to generate the code for each case. 
0139 578 ;:- 
0139 8579 
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0139 581 BYTE_TO_BYTE: S$BASSMAT_ADD 8, B 
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| 1-017 BASSMAT_ADD = Add 2 arrays giving a thi 6-SEP-1984 10:28:4 BASRTL.SRCJBASMATADD .MAR; 1 (5) 
S3er 286 BYTE_TO_WORD: S$BASSMAT_ADD 8, Ww 
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709 239 BYTE_TO_FLOAT: S$BASSMAT_ADD B, F 
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pcre 238 BYTE_TO_HFLOAT: SBASSMAT_ADD B, H 


I 16 
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1 
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j 
| EES 01: 
| i § ; Source array is a word array. Now differentiate on the destination type. 
! EFS 604 
| 05 06 £02 A3 F EF 605 WORD: cases oscee BTYPS RD? MDSCSK_DTYPE_B, #<DSCSK_DTYPE_D = DSCSK_DTYPE_B> 
9 D' OFFA 6 $ 18: WORD WORD_TO_BYTE-1$ 3; code for byté dtype 
E* QOEFC 60 «WORD WORD_TO_WORD-1$ 3 code for word dtype 
+9 €F 608 .W WORD TO_LONG-1$ ; code for long dtype 
Fe FO 609 ~WORD BATTYPERR=-1$ : quad not supported 
9 FD" 4 610 oW WORB_TO_FLOAT-1$ 3; code for float dtype 
7EE* : r oi) -WORD WORD-TO- DOUBLE-1$ ; code for double dtype 
18 «(02 " 3} oF 06 ei$ a DSCSB_DTYPE(R3), MDSCSK_DTYPE_G 
09E2 31 ore oF BRw WORD_TO_GFLOAT 
1c 02 A 7 OF 617 2s Hae SCSB_DTYPE(R3), #DSCSK_DTYPE_H 
OBD2 4 OF13 e18 BRwW WORD_TO_HFLOAT 
18 02 a 7 OF18 ? 1 3$ ae DSCSB_DTYPE(R3), #DSCSK_DTYPE _DSC ; array ¢ of tater ioters? 
3 branc no 
53 O4A 6 ois 6 : MOVL 4(R3), R3 3; move Bddr of desc in R3 
D111 arse e $ BRB WORD ; CASE again on dtype in desc 
F1D3) = ss 331 OF 34 636 4$: BRW ERR_DATTYPERR ; unsupported dtype 
OFoy 658 zs 
OF 27 663 : Now type of source and destination arrays are known. Use the macro to 
Os? 630 ; generate the code for each case 
OF27 631 ;:- 
OF27 632 
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OF 27 634 WORD.TO.BYTE:  SBASSMAT_ADD WB 
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1118 637 WORD_TO_WORD: $SBASSMAT_ADD wu, 
1306 638 
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13 640 WORD_TO_LONG: $BASSMAT_ADD We L 
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14F7 643 WORD TO_FLOAT: SBASSMAT_ADD  w, F 
16E8 644 
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1CE 655 3+ ; 
if £28 : Source array is a longword array. Now differentiate on the destination type 
1CE3 658 
02 AS 8F ICES 659 LONG: CASEB DSCSB_DTYPE(R3), #DSCSK_DTYPE_B, #<DSCSK_DTYPE_D - DSC$K_DTYPE_B> 
002D' 1CE8 660 1$: «WORD LONG_TO_BYTE-1$ ; code for byte dtype 
O21E* 1CEA 661 «WORD LONG_TO_WORD-1$ ; code for word dtype 
O4OF* 1CEC 66 «WORD LONG TO _LONG-1$ ; code for long dtype 
E412 1CE 66 -WORD ERR_BATTYPERR-1$ 3 Quad not supported 
OSFD* 1CF 664 WORD LONG_TO_FLOAT-1$ ; code for float dtype 
O7EE' be 922 «WORD LONG_TO_DOUBLE-1$ ; code for double dtype 
02 A3 91 #+1CF4 #8 667 CMPB DSCSB_DTYPE(R3), #DSCSK_DTYPE_G 
0 12 1CF8 668 BNEQ 
O9E2 31 ieee eH eRwW LONG_TO_GFLOAT 
02 AS 91 ICFD 671 2$ CMPB DSCSB_DIYPE(R3), #DSCSK_DTYPE_H 
03 12 1001 ore BNEC 
OBD2 31 1082 or? BRW ONG_TO_HFLOAT 
02 AS 91 1006 675 3$ CMPB DSCSB_DTYPE(R3), A#DSCSK_DTYPE_DSC ; array of descriptors? 
06 12 1D0A 676 BNEQ 4$ : branch if not 
04 AS 00 100C 677 MOVL 4(R3), R3 ; move addr of desc in R3 
D1 11 + ore BRB LONG 3; CASE again on dtype in desc 
E5E5 31 pit oY 4$: BRW ERR_DATTYPERR ; unsupported. dtype 
1D15 682 + : 
1015 683 ; Now type of source and destination arrays are known. Use the macro to 
1D15 684 ; generate the code for each case 
1D15 685 ;- 
1D15 686 
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F? 694 LONG.TO.LONG: $BASSMAT_ADD LL, L 
SOF Z 83g LONS_TO. ' 
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2808 704 


23:39:02 VAX/VMS Macro v04-00 Page 
10:28:41 (CBASRTL.SRCJBASMATADD.MAR; 1 


BASSMAT_ADD 
mite: a 


BASSMAT_ADD 
808 
AD1 


L 1 
15-SEP=1 
- Add 2 arrays giving a thi 6-SEP-1 


Be 5:28:27 UBASR 


706 LONG_TO_MFLOAT: SBASSMAT_ADD —L, H 


o V04-00 
TBASMATADD. MAR; 1 


re 


05 


06 


18 


02 A3 


BASSMAT_ADD 


ooUvuooo 


-SEP=-1 3 $3: 3B 0¢ rd god o V04-00 Page 37 

- Add 2 arrays giving a thi 6=-SEP=-1 8:4 BASRTL.S SBASMATADD. MAR; 1 (5) 
709 ;+ 
oY ; Source array is a floating array. Now differentiate on the destination type 
712° 
ig FLOAT: CASEB DSCS$B_DTYPE(R3), MDSCSK_DTYPE_B, #<DSCSK_DTYPE_D = DSCSK_DTYPE_B> 
714 18: <WORD FLOAT-TO_BYTE=1$ ; code for byte dtype 
715 «WORD FLOAT_TO_WORD-1$ 3 code for word dtype 
rig -WORD FLOAT TO LONG-1$ ; code for long dtype 
71 «WORD ERR_DATTYPERR-1$ 3; quad not supported 
718 WORD FLOAT_TO_FLOAT-1$ ; code for float dtype 
at, -WORD FLOAT_TO_DOUBLE-1$ ; code for double dtype 
721 CMPB DSC$B_DTYPE(R3), #DSCS$K_DTYPE_G 
7 ¢ BNEQ es 
4 Z BRW FLOAT_TO_GFLOAT 
458 2$ CMPB =: OSC$B_DTYPE(R3), #DSCSK_DTYPE_H 
726 BNEQ 3$ 
tse BRW FLOAT_TO_HFLOAT 
188 3$ CMPB DSCSB_DTYPE(R3), #DSCS$K _DTYPE _DSC ; array. 9 descriptors? 
730 BNEQ 4$ 3 branch if not 
731 MOVL 4(R3), R3 : move Bddr of desc in R3 
P36 BRB FLOAT : CASE again on dtype in desc 
734 4$: BRW ERR_DATTYPERR : unsupported dtype 
He 

bs + 
737 : Now type of source and destination arrays are known. Use the macro to 
i383 ; generate the code for each case 
740 * 
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CF4 745 FLOAT_TO_WORD: SBASSMAT_ADD fF, WwW 
EES 746 
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ces 748 FLOAT_TO_LONG: $BAS$MAT_ADD fF, L 
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BF 763 ;+ 
iH ee ; Source array is a double array. Now differentiate on the destination type. 
BF 766° 
02 A3 __ 8F 8BF reo DOUBLE: CASEB DSCSB_DTYPE(R3), #DSCSK_DTYPE_B, #<DSCSK_DTYPE_D = DSCSK_DTYPE_8> 
002D' 38(4 768 1$: -WORD DOUBLE_TO_BYTE-{$ ; code for byte dtype 
0231' 38C6 £6? -WORD DOUBLE_TO_WORD-1$ 3 code for word dtype 
0435" are 770 «WORD DOUBLE_TO LONG-1$ ; code for long dtype 
£836 CA 771 .WORD RR_DATTYPERR=-1$ 3 quad not supported 
0639" 38CC oe -WORD DOUBLE_TO_FLOAT-1$ ; code for float dtype 
083D' +93 ae -WORD DOUBLE-TO-DOUBL-1$ ; code for double dtype 
02 a3 91 3800 775 CMPB = OSCSB_DTYPE(R3), #DSCSK_DTYPE_G 
03 12 3804 776 BNEQ 
OA16 31 8p6 oe BRW DOUBLE _TO_GFLOA 
02 a3 91 309 779 28: CMPB sd DSC$B_DTYPE(R3), #DSCSK_DTYPE_H 
03 12 ty 780 BNEQ 
OCOA 31 3605 rt BRW DOUBLE_TO_HFLOA 
02 a3 91 38E2 38 3$: CMPB DSC$B ping #DSCSK_DTYPE _DSC ; array. of descriptors? 
06 12 3866 784 BNEQ 4$ : branch if not 
04 A3 DO 38E8 785 MOVL 4(R3) ; move addr of desc in R3 
D111 tas reg BRB DOUBLE * ; CASE again on dtype in desc 
C809 31 SB8EE 788 4$: BRW ERR_DATTYPERR 3 unsupported dtype 
38F1 789 
38F1 790 ;+ 
38F 1 791 : Now type of source and destination arrays are known. Use the macro to 
38F1 13¢ : _generate the code for each case 
38F1 793 :- 
38F 1 794 
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- Add 2 arrays giving a thi 6=-SEP-1984 
196 DOUBLE_TO_BYTE: SBASSMAT_ADD dD. B 
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BASSMAT_ADD = Add 2 arrays giving a thi 6S 
3AE5 799 DOUBLE_TO_WORD: SBASSMAT_ADD 
CF9 800 


Ep-1984 10:28:41 
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3CF9 4 DOUBLE_TO_LONG: S$BASSMAT_ADD D, 
3EFD =. 880 
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3EFD 8 DOUBLE _TO_FLOAT: SBASSMAT_ADD 0, F 
4101 06 
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4101 gee DOUBLE_TO_DOUBL: SBASSMAT_ADD 0D, D 
42EF 0 


-» | 
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N 
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1-017 BASSMAT_ADD = Add 2 arrays giving a thi 6=-SEP-1984 
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42EF 811 DOUBLE_TO_GFLOA: SBASSMAT_ADD 0D, 
44EC 81 
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4-617 BASSMAT_ADD = Add 2 arrays giving a thi 6-SEP=1984 10:28:41 CBASRTL.SRCIJBASMATADD.MAR; 1 (5) 
| 44EC 814 DOUBLE_TO_HFLOA: SBASSMAT_ADD D, H 
46ES B15 


; 5-SEP=1984 $338 39: 06 PAL yas Macro v04-00 Page 53 
BASSMAT_ADD = Add 2 arrays giving a thi "BrSEb=19 6 BASRTL.SRCIJBASMATADD.MAR; 1 (5) 


46E5 17 : 
ieee He ; Source array is a gfloat array. Now differentiate on the destination type. 
46E SF: 
02 A3_ BF rbd: 1 GFLOAT: CASEB OSC$B etree (a2? #DSCSK_DTYPE_B, #<DSCSK_DTYPE_D = DSCSK_DTYPE_8> 
00 D: SEA ; 1$: .wORD  GFLOAT_TO_BYTE-1$ ; code for byte dtype 
0227" 46EC - WORD GFLOAT“TO-WORD~1$ ; code for word dtype 
0421" 46E 4 «WORD GFLOAT_ TO _LONG-1$ ; code for long dtype 
BAI0 46F 5 «WORD RR_DATTYPERR-1$ 3; quad not supported 
O618: 46F $ «WORD FLOAT_TO_FLOAT-1$ ; code for float dtype 
0815° re oot «WORD GFLOAT_TO_DOUBL-1$ ; code for dbl dtype 
02 A391 «-46F6 CMPB =s-s OSCS$B_DTYPE(R3), #DSCSK_DTYPE_G 
03 12 46FA 0 BNEQ 
OOFE 31 46FC 31 BRW GFLOAT_TO_GFLOA 
02 A391 46FF 638 2$ CMPB SC$B_DTYPE(R3), #DSCSK_DTYPE_H 
0 12 4703 34 BNEQ $ 
OBF 1 31 rit} HH BRw GFLOAT_TO_HFLOA 
02 a3 91 4708 i837 3$ CMPB DSCS$B pre. #DSCSK_DTYPE_DSC ; array of Geeertpcaret 
0 12 470C 838 BNEQ 4$ : branch if no 
O4 A DO 470E 839 MOVL 2tR3) ; move addr of rae in R3 
dpi. aie 840 BRB GFLOA oat * ; CASE again for dtype in desc 
BIES 31 4714 Hk 4$ BRW ERR_DATTYPERR 3 unsupported dtype 
4717 B4 
4717 844 ;+ 
4717 39845 ; Now type of source and destination arrays are known. Use the macro to 
4717 846 ;_generate the code for each case 
4717 847 ;- 
4717 848 
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4717 850 GFLOAT_TO_BYTE: S$BASSMAT_ADD G, B 
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4B0B 856 GFLOAT_TO_LONG: SBASSMAT_ADD G, L 
4005 857 
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1-017 10:28:41 CBASRTL.SRCIBASMATADD.MAR; 1 (5) 
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| SOFD 866 GFLOAT_TO_GFLOA: SBASSMAT_ADD G, 
| 52-9 = 867 


; 


— mh 


§ 3 
ASSMAT_ADD 15-SEP-1984 23:39:0 AX/VMS Macro V04-00 Page 6 
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oer 668 GFLOAT_TO_HFLOA: SBASSMAT_ADD GG, H 
4F9 0 
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BF 54F9 
00 D: 4F 
Q227" 550 
0421" 550 

ABFC 5504 

$018, 258 
0815° 550 

SOA 

91 550A 
12 550€ 
31 551 
551 
91 551 

12 5517 

31 5519 
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12 5520 
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source array is an hfloat array. 


DSC$B DIYPE(R3) 
HFLOAT_TO_BYTE-1$ 
NELOAT“TO“WORD=1$ 
HF LOAT-TO-LONG=-1$ 
TT 
HFL 
HFLOAT~T0_DOUBL=1 
DSCS$B_DTYPE(R3), 
HFLOAT_TO_GFLOA 
DSC$B_DTYPE(R3), 
HFLOAT_TO_HFLOA 
DSC$B_DTYPE(R3), 
4$ 


4(R3), R3 
HFLOAT 


ERR_DATTYPERR 
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Now differentiate on the destination type. 


#DSCSK_DTYPE_B, igen * DTYPE_D = DSCSK_DTYPE_B> 


Sete Se Ge Ge Be 


$ 
#DSCSK_DTYPE_G 


#DSCS$K_DTYPE_H 


#DSCSK_DTYPE_DSC 


r byte dtype 
code for ne dtype 
code for long dtype 
quad not supported 
code for float dtype 
code for double dtype 


3; array of acai 
branch if not 

move addr of desc in R3 

CASE again for dtype in desc 


unsupported dtype 


s@ 
; Now type of source and destination arrays are known. Use the macro to 
: generate the code for each case 
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S91F 911 HFLOAT_TO_LONG: $BASSMAT_ADD 4H, L 
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918 


2 
1 


3:39: 
0:28 


02 
741 


VAX/VMS Macro v04-00 
CBASRTL.SRCJBASMATADD.MAR; 1 


Page 


66 
(5 


) 


1 


c— 


15-SEP-1984 9:0 AX/VMS Macro v04-00 Pa 
BASSMAT_ADD = Add 2 arrays giving a thi gosep-} one $5: 38: o EBASRTL.SR CIBASMATADD MAR: 1 - 


5F 0D 389 HFLOAT_TO_GFLOA: SBASSMAT_ADD 4H, G 
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1-017 BASSMAT_ADD = Add 2 arrays giving a thi BuSEP=198 


610D 923 HFLOAT_TO_HFLOA: SBASSMAT_ADD 4, 
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4 23: 
4 10:28:41 (CBASRTL.SRCIBASMATADD.MAR; 1 (5) 
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15-SEP-1984 23:39:0 AX/VMS Macro v04-00 Page 69 
BASSMAT_ADD = Add 2 arrays giving a thi boseP-} 984 $9:38,04 EBASRTL. SRE IBASMATADD.MAR: 1 . (6) 
6 88 925 ;+ , 
? 4 2 § : Add has ween in byte. Determine destination type to convert to dest. 
6309 928 * 
6309 929 FST .CASE 8 
55. SA D0 6309 930 30$: MOVL R10, R5 3 save original pointer 
05 06 02 A5 8F 630C 931 318:  CASEB DSC$B_DTYPE(RS), #DSCSK_DTYPE_B, #<DSCSK_DTYPE_D - DSC$K_DTYPE_B> 
Q19A* 6311 9 ¢ 1$: «WORD STORE BYTE-1$ 3 no conversion needed 
Oera 631 5 «WORD DEST_B_TO_wW-1$ ; code for word dtype 
89" 631 oae «WORD DEST_B TO L-1$ ; code for long dtype 
434 631 935 -WORD ERR_BATTYPERR-1$ 3 Quad not supported 
04 e. 6319 339 -WORD DEST_B_TO_F-1 ; code for float dtype 
OSA7" oei5 , f -WORD DES1_B_TO_D-1$ ; code for double dtype 
631D 335 3+ 
631D 940 ; To avoid having to specify ‘ERR_DATTYPERR' ,or all the cases in between 
o3i0 33) ; double and gfloat (dtypes 12 to 26), check for gfloat and hfloat separately. 
631D 308 : 
1B 402 AS 91 631D «944 CMPB ss OSCSB_DTYPE(RS), #DSCS$K_DTYPE_G 
03 12 6321 945 BNEQ ; dest not gfloat 
0708 31 $3 ; 6 BRw DEST_B_TO_G 
1¢ 02 AS 91 6326 948 2 CMPB = OSCSB_DTYPE(RS), #DSCS$K_DTYPE_H 
03 12 632A 949 BNEQ ; dest not hfloat 
081A 31 632¢ 990 BRW DEST_B_TO_H 
18 02A5 91 632F 926 3$ CMPB DSCSB_DTYPE(RS), MDSCSK_DTYPE_DSC ; array of descriptors? 
06 12 6333 95 BNEQ ; branch if not 
55 04 A5 DO 6335 954 MOVL 4(R5), RS 3: move addr of desc to R5 
D111 o333 822 BRB 31$ ; CASE again for dtype in desc 
908C 31 6338 957 4$ BRW ERR_DATTYPERR ; if we get here, must be an 
Ose 338 ; unsupported data type 
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BASSMAT_ADD = Add 


2 arrays giving a thi 


"BoSEP=198e f:28:41 UGASRTL.SREIBASRATADD.MaR:1 9° 79, 


ave or yee pointe 
code for byte dtype 


; No conversion needed 
; code for long dtype 

; quad not supported 

; code for float dtype 
; code for double dtype 


dest not gfloat 


dest not hfloat 


array y Senersptere 


; move addr of desc to R5 


CASE again for dtype in desc 
unsupported dtype 


ve oO TyPE. pointe 
code for byte dtype 


; code for word dtype 

; no conversion needed 
; quad not supported 

; code for float dtype 
; code for double dtype 


dest not gfloat 


dest not hfloat 


; array. i descriptors? 
move addr of desc to R5 


; CASE again for dtype in desc 


unsupported dtype 


633E 
? ; Be add has been in word. Determine destination type to convert to dest. 
633E J 
653€ 368 ST_CASE W 
DO 633E 368 $: MOVL R10, R5 
F 6341 967 33$:  CASEB ODSC$B DTYPE(RS), #DSCSK_DTYPE_B, "#<DSCSK D 
0136" 6 ‘6 968 1$: «WORD DEST_@ TO B-1$ : 
0274" 634 4 ~ WORD STORE QoRB-1$ ; 
0359° 634A 970 -WORD DEST.@_TOL-1$ 5 
9DB4 634C 971 -WORD ERR_BATTYPERR-1$ s 
+68) 6 ef 97 -WORD DEST_W_TO_F-1$ : 
585° ? 2 a7 -WORD DEST_W_TO_D-1$ ; 
91 6 3 975 CMPB DSCSB_DTYPE(RS), #DSCSK_DTYPE_G 
12 6356 378 BNEQ 2s 3 
31 6358 97 BRW DEST_W_T0_G 
6358 978 
91 6358 979 2s: CMPB ss DSC SB_DTYPE(RS), #DSCS$K_DTYPE_H 
12 635F 980 BNEQ 3$ ; 
31 oye} 44 BRW DEST_W_TO_H 
91 6364 983 3S: CMPB = DSCSB_DTYPE(RS), #DSCSK_DTYPE_DSC ; 
12 6368 984 BNEQ 4$ ; branch if not 
DO 636A 985 MOVL 4(R5), RS ¢ 
11 o36F o88 tas 33$ : 
637 98 
31 637 988 4$: BRw ERR_DATTYPERR : 
637 989 ;+ : 
O37 44 ; Add has been in long. Determine destination type to convert to dest. 
637 992 DEST_CASE_L: 
D0 6373 99 ee: MOVL R10, R5 
8F 6376 994 35$: CASEB osc$e DTYPE(RS), #DSCSK_DTYPE_B, "#<DSCSK D 
0106' 6378 995 18: .WORD DEST_C_TO_B-1$ ; 
0215° 6370 996 -WORD DEST L TO W-1$ : 
Q34E° 637F 997 ~ WORD STORE _CONG-1$ : 
9D7F 6381 998 ~ WORD ERR_DATTYPERR-1$ : 
0438" 6383 999 -WORD DEST_L_TO_F-1$ ; 
0563° oeee 1900 «WORD DEST_L_TO_D-1$ 3 
91 6387 1008 CMPB = DSCSB_DTYPE(RS), #DSC$K_DTYPE_G 
12 6388 100 BNEQ 2$ : 
31 $360 13 BRW DEST_L_TO_G 
6390 1005 
91 6390 1006 2s: CMPB DSC$B_DTYPE (RS), #DSC$K_DTYPE_H 
12 6394 1007 BNEQ $ 3 
31 6396 1008 BRW DEST_L_TO_H 
oeoe 1009 
91 6399 1010 3$: CMPB = DSCS$B_DTYPE(R5), #DSCSK_DTYPE_DSC 
if} 6390 1011 BNEQ : branch if not 
DO 639F 1 i MOVL 4(R5), R5 Z 
11 63A3 101 BRB 35$ 3 
6 ~ 1313 
31 63A 1015 4$: BRw ERR_DATTYPERR : 
esas 1016 i+ ; : : ; 
63A8 1017 ; Add has been in float. Determine destination type to convert to dest. 


YPE_D = DSCSK _DTYPE_8> 


YPE_D - DSC$K _DTYPE_B> 


H 4 


BASSMAT_ADD 15-SEP-1984 23:39:0 AX/VMS Macro v04-00 Page 71 
1-017 BASSMAT_ADD = Add 2 arrays giving a thi 6-SEP-1984 fidaick EBASRTL. SRE IB BASMATADD.MAR;1 > (7) 
63A8 1 18 i- 
63A8 101 
65A8 1020 DEST_CASE _F 
55 SA DO 63A8 1021 $3: MOVL R10, R5 ave origina! pointe 
05 06 02 AS BF 63A 10 ¢ $: CASEB osc$e DTYPE(RS), #DSCSK_DTYPE_B, "#<DSCSK D Qe D- DSCSK _DTYPE_8> 
8006; 638 18 1$: -WORD DEST_F_TO_B-1$ : code for byté dtype 
1E5° 6382 1024 «WORD DEST_F-TO_W-1 ; code for word dtype 
O2F4° 6384 18 5 eWORD DEST F TO L-1 ; code for long dtype 
904A 6 a6 1 § -WORD ERR_BATTYPERR-1$ 3; Quad not supported 
0428" 638 18 «WORD STORE _FLOAT-1$ 3 no conversion needed 
| 0541" ° * ; 3 «WORD DEST_F_TO_D-1$ :; code for double dtype 
1B 02 A591 Saar 1 0 CMPB = DSC $B_DTYPE(RS), #DSCSK_DTYPE_G 
03 12 es Ie) BNEQ 2$ ; dest not gfloat 
| 067E 31 6 ¢ 103¢ BRw DEST_F_T0_G 
1c 602 AS 9 g3ce 1034 2$ CMPB = DSC$B_DTYPE(RS), #DSCSK_DTYPE_H 
03 12 63C9 1035 BNEQ 3$ ; dest not hfloat 
078D 31 ogee 1339 BRW DEST_F_TO_H 
18 O02 A5 91 63CE 1038 3$ CMPB DSC$B_DTYPE(RS), #DSCSK_DTYPE_DSC ; array of alate iotors? 
06 12 63D2 1039 BNEQ 4$ > branch i 
55 04 A5 D0 6304 1040 MOVL 4(R5), RS 3; move addr of dees to RS 
D1 11 oe08 + od BRB 37$ ; CASE again for dtype in desc 
901D 31 roe 1948 4$: BRW ERR_DATTYPERR 3; unsupported dtype 
ope ok ; Add has been in double. Determine destination type to convert to dest. 
63DD 1047 
oyoe 1048 DEST_CASE_D 
55 SA DO 63DD 1049 38$: MOVL R10, R5 ave original point 
05 06 02 AS 8F 63E0 1050 39S: CASEB osc$B DTYPE(RS), #DSCSK_DTYPE_B, * peDSeSK DIYPE_D - DSC$K _DTYPE_B> 
00A6' ose s 1051 1$: -WORD DEST_B_T0_8-1$ ; code for byte dtype 
0185° 637 1036 -WORD DEST_D_TO_W-1$ : code for word dtype 
024" 63E9 105 «WORD DEST 0 L-1$ : code for long dtype 
9015 63EB 1054 -WORD ERR pari Penn ts 3 quad not supported 
03D3* 63ED 1055 -WORD DEST_D F-1$ ; code for float dtype 
056C" oat 1928 . WORD STORE. BOUBLE-1$ 3 no conversion needed 
1B 402 AS O91 63F1 1058 CMPB DSCSB_DTYPE(RS), #DSCSK_DTYPE_G 
03 12 63F5 1059 BNEQ 
064F 31 one «4 BRW DEST_D_TO_G 
1C 02 AS 91 i 1062 3$: CMPB DSCSB_DTYPE(RS), #DSCSK_DTYPE_H 
03 12 63FE 106 BNEQ ; dest not hfloat 
| O75—€ 31 att 1908 BRw DEST_D_TO_H 
18 O2 AS 91 Sto 1206 28: CMPB DSCSB_DTYPE(RS), #DSCS$K_DTYPE _DSC ; array gt descriptors? 
06 12 6407 106 BNEQ 4$ : branch if not 
| 55 04 A5 D0 6409 1068 MOVL 4(R5), R5 3 move addr of desc to R5 
D1 11 one 139? BRB 39$ ; CASE again for dtype in desc 
| 9CE8 31 6408 1071 4$ BRW ERR_DATTYPERR ; wmeusper tee etyge 
641 1078 ; (or gfloat, w Ni is not 
| 641 107 2 cuntelted w/dbl) 
641 1074 ;+ 
| 
| 
| 


oe en 
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| ) ! 76 ; Add has been in gfloat. Determine destination type to convert to dest. 
6412 1077 ° 
6412 1 8 DEST CASE G: 
3 0 6412 1079 40S: MOVL R10, R5 esc" iinet poin 
05 06 £02 AS F 641 1 $9 41$: CASE6 oscés DTYPE(RS), #DSCSK_DTYPE_B, * pebsesx DIYPE_D = DSeSk _DTYPE_8> 
0087' 641A 1081 1$: -WORD DEST_G_TO_B-1$ ; code for byté dtype 
0196" 641C 108¢ -WORD DEST-G-TO-w-1$ ; code for word dtype 
O2A5° 641E 1 «WORD DEST GTO L-1$ ; code for long dtype 
9CEO 64 Ht «WORD ERR_BATTYPERR-1$ 3; quad not supported 
0384" 64 1085 «WORD DEST_G_TO_F-1$ ; code for float dtype | 
O4F0° os 1 1989 -WORD DEST_G_TO_D-1$ ; code for double dtype 
1B 02 A5 91 6426 1088 CMPB 4 =s-« DSCSB_DTYPE(R5), #DSCSK_DTYPE_G | 
93 12 642A 1089 BNEQ 2s ; dest not gfloat 
0635 = 31 64 : 1090 BRW STORE_GFLOAT 
1¢ 02 a 4 o 5 1398 2$ cee ee rere. #DSCSK_DTYPE_H 
0740 (31 6433 109% BRW DEST_G_TO_H 
18 02 ae 4 rob, 1999 3$ ot OSCSS_DTYPE (RS) . #DSCSK_DTYPE_DSC ; orray 9 of agseriocers? 
: branc 
55 04 AS DO 643E 1098 MOVL 4(R5), R5 3 move addr 7 desc to R5 
D1 11 eet 44 BRB 41$ ; CASE again for dtype in desc 
9CB3 «= 331 6444 «(1101 48 BRW ERR_DATTYPERR : uneusported dtype 
6447 1106 ; (note that dbl is unsupported 
6447 110 with gfloat) 
Seep 1408 
34 
ort 1198 ; Add has been in hfloat. Determine destination type to convert to dest. 
6447 1108 * 
6447 1109 DEST_CASE_H 
55 SA DO 6447 1110 tt MOVL R10, R5 ave or igingl pointe 
05 06 02 AS BF 644A 1111 438: CASEB osc$B DTYPE(RS), #DSCSK_DTYPE_B, * pedsesx DIYPE_D - DSC SK _DTYPE_B> 
0058" 644F 1346 1$: ~ WORD DEST_A_T0_B-1$ : code for byte dtype 
0167° 6451 111 -WORD DEST_H_TO_W-1$ ; code for word dtype 
0276* 6453 1114 «WORD DEST_H TO L-1$ ; code for long dtype 
9CAB 6455 1115 -WORD ERR_BATTYPERR-1$ 3 quad not supported 
0385" 6457 1116 «WORD DEST_H_TO_F-1$ : code for float dtype 
04EB" yt h4 BAT -WORD DEST_H_TO-D-1$ : code for dbl dtype 
1B O02 AS 91 6458 1419 CMPB DSCSB_DTYPE(RS), #DSCSK_DTYPE_G 
03 12 645F 1120 BNEQ 2$ : dest not gfloat 
OSFC 31 eee) 1136 BRW DEST_H_TO_G 
| 1c 02 AS) «(91 6464 «11 g 2s: CMPB SCSB_DTYPE(RS), #DSCSK_DTYPE_H 
03 12 6468 1124 BNEQ & 3; dest not hfloat 
O70F 31 Pe i 5 BRW STORE _HFLOAT 
18 02 A5 91 646D 11 5 3$ CMPB DSCSB_DTYPE(RS), #DSCSK_DTYPE _DSC ; array. of descriptors? 
0 12 6471 1128 BNEQ 4$ : branch if not 
55 O04 A DO 6473 1129 MOVL 4(R5), R5 ; move Bde of desc to R5 | 
Di «8611 6477 11350 BRB 43% ; CASE again for dtype in desc 
6479 1131 | 
| | 
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BASSMAT_ADD = Add 2 arrays giving a thi "38 Epn19 4 8:41 ([BASRTL.SRCJBASMATADD.MAR; 1 (7) 
| 9C7E = 31 Sore 1} g 4$: BRW ERR_DATTYPERR 3 unsupported dtype 
| 
647C 1134 DEST_W_TO_B: 
50 50 33 647C 1135 “ CVTwB RO, RO 3 convert 
2a 47 1 § BRB STORE_BYTE : go store 
6481 1138 DEST_L_T0.B: 
50 50 «F6 6481 1139 COTLB RO, RO ; convert 
25 11 «6484 1140 BRB STORE _BYTE ; go store 
6486 1141 
6486 1136 DEST_F_TO_B 
50 50 48 oes 114 cOTFB RO, RO 3; convert 
20 11 6489 1144 STORE_BYTE ; go store 
6488 1145 
6488 1146 DEST_D_TO_B: 
7E 70 6488 1147 mMOvd z: save double 
DO 648E 1148 MOVL Pe. save FPCEP), RO > pass FP to get scale 
O0000000'GF 16 6492 1149 JSB enBASS$s CALE 5 get scale in RO & R1 
BE 67 6498 1150 DIvD3 RO, (SP)+, : descale for byte 
50 50 68 649C 1151 CVTOB 3; convert to byte 
11 649F 1136 BRB STORE_BYTE 
64A1 115 
64A1 1154 DEST_G_TO_B: 
50 50 48FD 64A1 1155 gviG GB RO, RO 3 convert 
04 11 64A5 1156 STORE BYTE ; go store 
64A7 1157 
64A7 1158 DEST_H_TO i. 
50 50 68FD 64A7 1159 CVTH RO, RO 3 convert 
64AB 1160 3 fall into store 
64AB 1161 STORE_BYTE: 
1 A DO 64AB 1166 MOVL R10, R1 : pointer to dest descriptor 
52 O08 AE DO 64AE 116 MOVL lLower_bnd1+4(SP), R2 : current row (extra longword 
64B2 1164 ; on top of stack for jsb) 
3 5B 00 6482 1165 MOVL R11, R3 : current column 
28 AE 50 90 o82 1138 p MOVB RO, DATA+4(SP) 
6489 1168 ; Redefine the a offsets 9 the call to the STORE macro. The 
6489 1169 ; BSBW to here added 4 to the stack. 
6489 1170 :- 
6489 1171 
00000020 6489 1178 value_desc = 32 
00000020 6489 1173 str_lén = 
sass ofS 6489 1174 dtype = 34 
000000 6489 1175 class = 35 
00000024 6489 1128 pointer = 36 
00000028 6489 1177 data = 40 
6489 1178 
6489 4 STORE 8B 3 store 
1181 ; Restore the following offsets. 
658A 11 § 3° 
658A 11 
Q000001C 658A 1184 value_desc = 28 
0000001C 658A 1185 str_lén = 
QOOOO01E 658A 11 $ dtype = 
QOOO001F 658A 1187 class = 31 
00000020 658A 1188 pointer = 3 
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heir BASSMAT_ADD = Add 2 arrays giving a thi 6=-SEP-1984 $3; 3Bi54 BASNTL. CRE TBASMAT OOD. MAR: 1 sta 3) 
| 00000024 658A 1189 data = 36 
658A 1190 
AE hee 
6588 1193 DEST_B_TO w: 
50 50 99 6588 1194 “= cl0TBw RO, RO 3 convert 
| 2a 68E 1195 BRB STORE _WORD : go store 
£890 1197 DEST_L_TO_w: 
» DBD 7 o34 1198 CVTLW = =RO, RO 3 convert 
25 «11 639 1199 BRB STORE _WORD : go store 
g8ge | 01 DEST_F_TO_w: 
"4 35 H $358 i 8 al OTORE WORD iS ote 
a 3 go store 
659A 1204 
659A 1205 DEST_D_T0_w: 
7E 50 70 659A 1 06 mMOVD RO, =-(SP) 3; save double 
50 OC AD DO 659d 120 MOVL  SF$L_SAVE_FP(FP), RO : pass FP to get scale 
00000000 ' GF 16 65A1 1208 JSB G*BASSSSCALE_R1 ; get scale in RO & R1 
50 8€ 50 67 65A7 1209 DIVD3 RO, (SP)+, RO 3: descale for dest 
0 69 65AB 1210 CVTDW ‘ 3 convert to word 
OA 11 e2ne . uy BRB STORE _WORD ; go store 
$380 1518 DEST_G_T0_w: n 
50 50 49FD 6580 1214 CVTGw RO, RO 3 convert 
04 11 £344 1$12 BRB STORE _WORD ; go store 
6586 1519 DEST_H_TO_w: 
50 50 69FD 6586 118 CVTHW RO, RO i: convert 
tro. \¢13 : fall into store 
65BA 1221 STORE _WORD: 
51 SA 00 65BA 12 ¢ MOVL R10, R1 i pointer to dest descriptor 
52 08 AE 00 6580 122 MOVL Lower_bnd1+4(SP), R2 3; current row (extra longword 
65C1 1224 3; on top of stack for jsb) 
53 5B oO 65C1 1225 MOVL R11, R3 3; current column 
28 AE 50 60 b2ts \¢s6 MOVW RO, DATA+4(SP) 
65C8 1556 : Redefine the following offsets for the call to the STORE macro. The 
65C8 1229 ; BSBW to here added 4 to the stack. 
gt 1g 
00000 65¢8 1 value_desc = 32 
80 000 rate 1 38 str_lén = 32 
000000 65C8 1234 dtype = 3 
000000 65C8 1235 class = 35 
00000024 65(8 1 § pointer = 36 
00000028 e208 : data = 
2288 1339 . STORE WwW 3 store 
6699 1241 ; Restore the following offsets. 
$699 1348 
0000001C 6699 1244 value_desc = 28 
0000001C 6699 1245 str_léen = 28 
| 
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46 dtype = 30 
t3 slees = 3 
8 pointer = 32 
2 data = 36 
2) RSB 3 go continue loop 
34 DEST_B_TO_L: 
54 CVTBL = =sRO, RO 3 convert 
33 BRB STORE _LONG 3 go store 
28 DEST_W_TO_L: 
58 CVTweL =saRO,- RO 3 convert 
23 BRB STORE _LONG 3; go store 
61 DEST_F_TO_L: 
66 COTF RO, RO 3 convert 
o7 BRB STORE _LONG ; go store 
65 DEST_D_TO_L: 
66 MOV RO, -(SP) 3 save double 
67 MOVL SFSL_SAVE_FP(FP), RO ; pass FP to get scale 
68 JSB G*BASSS$SCALE_R1 3 get scale in RO & R1 
69 DIVD3 RO, (SP)+, RO 3; descale for dest 
70 CVTOL RO, R 3 convert 
4 BRB STORE _LONG 3 go store 
rg DEST_G_TO_L: 
74 CVTGL RO, RO 3: convert 
o? BRB STORE _LONG ; go store 
77 DEST_H_TO_L: 
78 CVTHL RO, RO : convert 
79 ; fall into store 
80 STORE_LONG: 
81 MOVL R10, R1 ; pointer to dest descriptor 
S MOVL Lower_bnd1+4(SP), R2 3; current row (extra longword 
8 3; on stack for jsb) 
84 MOVL R11, R3 ; current column 
8? MOVL RO, DATA+4(SP) 
3¢ 
87 ; Redefine the following offsets for the call to the STORE macro. The 
H+ : BSBW to here added 4 to the stack. 
90 ° 
91 value_desc_= 32 
3 str n $47 
e = 
94 citon = 35 
95 pointer = 36 
96 data = 
97 
38 STORE L 3; store 
se 
9 3; Restore the following offsets. 
02 ° 


———— —E 
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lue_desc = 32 
r_len = 3 


1 

g 

4 

5 

$ 

8 

9 

0 

1 

g 

4 

3 : 

; ;_BSBW to here added 4 to the stack. 
0 

1 

g 

4 

5 

STORE F 3; store 
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Q00001C 67A8 1303 value_desc = 28 
000001¢ 67A8 1304 str_lén = 28 
444 1E 67A8 1305 dtype = 3? 
| OOOOOIF 67A8 1 $ class = 31 
it SY 67A8 1 8 pointer = 32 
00000024 er ; 8 data = 36 
05 67A8 1310 RSB 3 go continue loo 
67A9 1311 : 
67A9 1 1 DEST_B_T0_F: 
50 50 4€ 67A9 131 CVTBF RO, RO 3; convert 
2A «11 «67AC «(1314 BRB STORE_FLOAT i go store 
67AE 1315 
67AE 1 16 DEST_W.TO F: 
50 50 4D 67AE 131 CVTwF RO, RO 3; convert 
25 11 6781 1318 BRB STORE _FLOAT ; go store 
6783 1319 
6783 1320 DEST_L_TO_F: 
50 50 4E& 6783 1321 CVTLF RO, RO 3 convert 
20 11 6786 1356 BRB STORE _FLOAT ; go store 
6788 132 
6788 1324 DEST_D_TO_F: 
7E 50 70 6788 1325 mMOVD RO, =-(SP) 3: save douple 
50 OC AD DO 67BB 1326 MOVL  SFS$L_SAVE_FP(FP), RO > pass FP to get scale 
00000000'GF 16 67BF 1327 JSB G*BASSSSCALE_R1 3 get scale in RO & R1 
50 8€ 50 67 67C5 1328 DIVD3 RO, (SP)+, RO 3; descale for dest 
50 76 67C9 13$3 CVTDF 3; convert 
OA 11 oree 3 0 BRB STORE _FLOAT ; go store 
67CE 1332 DEST_G_TO F: 
50 50 33FD 67CE 13 CVTGF RO, RO 3 convert 
046 #11 of ¢ 13 BRB STORE _FLOAT ; go store 
67D4 13 DEST_H_TO F: 
50 50 FOFD 67D4 1 COTHF =RO, RO ; convert 
6708 13 ; fall into store 
67D8 1339 STORE_FLOAT: 
51 5A 00 6708 13 MOVL R10, R1 3; pointer to dest descriptor 
52 O08 AE 00 67DB 13 MOVL Lower_bnd1+4(SP), R2 ; current row (extra longword 
6 13 3: on stack for jsb) 
5S$ 3S 00 6 13 MOVL R11, R3 3: current column 
28 AE 50 50 ? 3 A MOVF RO, DATA+4(SP) 
of ! Redefine the following offsets for the call to the STORE macro. The 
6 1 
6 1 
6 1 
6 1 
6 1 
6 1 
6 1 
6 1 
6 1 
6 1 
6 1 
6 1 


PUPP EBS BS BE EE EAA II 


3¢ 
; Restore the following offsets. 
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ec 
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7E 
50. = OC AD 
00000000 ' GF 
50 sO8BE 
0086 
50 
50. =OC AD 
00000000 ' GF 
50 a 
007 
7E =—50 
50 OC AD 
~onta * od 
0060 


50 

50 OC AD 
00000000 ' GF 
50. —soBE 
00000000 ' GF 
0047 


7E 26 
a 

500550 

7 50 

5 8E 

52. BE 

C AD 

090098 0° GF 
et 
eoeopyoe"ss 


001 
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PDORAGCAAOOOO 
ooOwowowowowvownowvovns 
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60 ;- 
61 
26 value_desc = 28 
65 str_léen = 28 
64 dtype = 
65 class = 
06 pointer = 32 
ti data = 
$3 RSB 3; go continue loop 
71 DEST_B_TO_D: 
ys CVTBD RO, (SP) 3; save double 
? MOVL  SF$L_SAVE_FP(FP), RO : pass FP to get scale 
74 JSB G*BASSS$SCALE_R1 i get scale in RO & R1 
75 MULD2 (SP)+, R ; Scale for dest 
#8 BRW STORE DOUBLE ; go store 
378 DEST_W_TO_D: 
79 CUTwD = =RO, =(SP) 3; save double 
380 MOVL SFS$L_SAVE_FP(FP), RO 3; pass FP to get scale 
381 JSB G*BASS$SCALE_R1 i get scale in RO & R1 
$86 MULD2 (SP)+, R ; scale for dest 
Ser BRW STORE _DOUBLE 3; go store 
385 DEST_L_TO_D: 
386 CVTLD 0, =(SP) 3: save double 
387 MOVL  SFS$L_SAVE_FP(FP), RO : pass FP to get scale 
388 JSB G*BASSSSCALE_R1 z get scale in RO & R1 
389 MULD2 (SP)+, RO 3; Scale for dest 
$09 BRW STORE _DOUBLE ; go store 
308 DEST_F_TO_D: 
39 COTFD RO, =(SP) : save double 
394 MOVL  SFSL_SAVE_FP(FP), RO > pass FP to get scale 
95 JSB G*BASS$$SCALE_R1 ; get scale in RO & R1 
396 MULD2 (SP)+, R ; scale for dest 
397 JSB G*MTHSDINT_R4 : integerize 
338 BRW STORE _DOUBCE ; go store 
400 DEST_G_T0_D: 
186 3 Note the intermediate conversion to hfloat. 
104 MOVL Re. -(SP) ; save regs which CVTGH 
405 MOVL R35, -(SP) ; will destroy 
406 CVTGH RO, RO 3; cvt gfloat to hfloat 
407 CVTHD RO, -(SP) 3 cvt to desired double 
408 MOVL (SP)+, R3 : restore regs 
409 MOVL (SP)+, R2 
410 MOVL  SFSL_SAVE_FP(FP), RO : pass FP to get scale 
411 JSB G*BASSSSCALE_R1 : get scale in RO & R1 
tig MULD2 (SP)+, RO 3; Scale for dest 
41 MOVL 4, =(SP) > save R 
414 JSB G*ATHSDINT_R4 ; integerize 
415 MOVL (SP)+, R4 3; restore R4 
416 BRW STORE DOUBLE 
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5 
BASSMAT_ADD SEP=1984 9:02 YAX/VMS Macro V04-00 P ? 
i 17 BASSMAT_ADD = Add 2 arrays giving a thi B8Ep= 198s $5:38554 UBASRTL. SRCIBASMATADD.MAR;1 7° (3) 


ei Iu 
693A 1419 DEST_H_TO_D 
7E SO F7FD 693A 1420 ath HD RO, =(SP) 3; save double 
50 Of D obo 69 1421 MOVL SFSL gave Fe rece RO ; pass FP to get ogete 
oonoggon'gs Te See 1tge SEL) SCBASESEERLELR : Bet scale in RO ei 
; r 
00000000°GF 16 6948 1454 TSB G°MTHEDINT_RG ; integerize 
$33 1¢ 5 3; fall oh store 
52. 5A DO gost 14 STE Rte, a i dest descri 
° ’ t t t 
53 O8 AE 00 6358 1° : MOVL Lower_bnd1+4(SP), R3 5 current roy Cexere’ Longuord 
3; on stack for 
54 58 0 695 1431 MOVL R11, R4 3 t l 
28 ae 800 6958 143¢ MOVD «RO, DATA+4(SP) eer ot 
695F 1434 3 Redefine the ee a offsets of the call to tie STORE macro. The 
695F 1435 ; BSBW to here added 4 to the stack. 
Get tse 
00000020 695F ieee ve value_desc_= 32 
00000020 695F 1439 str_lén = 32 
000000 ¢ 695F 1440 atyse = 
000000 695F 1441 class = 35 
00000024 695F 1ec6 pointer = 36 
00000028 o32F 170% data = 40 
{4 14ez STORE OD 3; store 
6A30 1447 : Restore the following offsets. 
BAS tie 
0000001C 6A30 1450 value_desc = 28 
0000001C 6A30 1451 str_lén = 28 
OOOOO0IE 6A30 1436 dtype = 30 
QOOOOO1F 6A30 1453 class = 31 
00000020 6A30 1454 pointer = 32 
00000024 r 5 1486 data = 3 
05 6A30 145 RSB : ti l 
ah 1089 DEST_B. 10 G ne eps Sota 
50 50 4CFD 6A31 1460 shea cots BG RO, RO 3; convert 
2 0=«Oo1 6A 3 1461 STORE_GFLOAT > go store 
437 1288 DEST_W_TO G: 
50 50 4DFD 6A57 1464 CVTwG RO, RO 3 convert 
27 11 a 4 1092 BRB STORE _GFLOAT ; go store 
6A3D 1269 DEST_L_TO G: 
50 50 4EFD 6A3D 1468 CVTLG RO, RO 3 convert 
21.11 Gad 14669 BRE STORE_GFLOAT : go store 
GAGs 1471 DEST_F_T0.G: 
50 50 99FD 6A4 1476 COTFG RO, RO 3 convert 
18 11 6A47 147 BSB STORE_GFLOAT ; go store 
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| 
6A49 
| 6A49 DEST_D_T0_G: 
6A49 3? 
vt ; Note the intermediate conversion to hfloat. 
7E DO 6A49 MOVL ei: -(SP) 3 save regs which CVTDH 
7E 6A4C MOVL : mal ; will destro 
3 8 2FD 6AGF CVTDH 3 cvt dbl to hfloat 
6FD 6A5 CVTHG R 3; cvt to desired gfloat 
é —E DO 6A5 MOVL nOs 3 restore regs 
8E 3 6A5A MOVL (SP)¢ 4 
0004 1 rs BRW STORE. GFLOAT 
6A60 DEST_H_T0_G: 
50 50 76FD 6A60 CUTHG RO, RO : 


convert 
fall into store 


STORE _GFLOAT: 
52. SA DO 6A64 MOVL pointer to dest descriptor 
53 08 AE DO 6A67 


R10, R2 ; 
MOVL Lower_bnd1+4(SP), R3 ; current row (extra longword 
: on stack for jsb) 


SODOCO0O 00000000000 0000000000 00000008 WINN 


1474 
He 
1627 
14 § 
1480 
1283 
14 § 
1484 
1286 
1289 
1488 
1489 
1490 
3 
it 
54 5B DO 6A 1495 MOVL R11, R4 current column 
28 AE 50 SOFD oe 1? $ MOVG RO, DATA#4(SP) 
6A73 1498 ; Redefine the po offsets 4 the call to the STORE macro. The 
6A73 1499 ; BSBW to here added 4 to the stack. 
SAE 1380 
00000020 6A73 15 ; value_desc = 32 
000000 6A73 1503 str_lén = 32 
000000 6A73 1504 dtype = 34 
000000 6A75 1505 class = 35_ - 
00000024 6A73 15 $ pointer = 36 
00000028 6A73 1507 data = 40 
6A73 1508 
BG HN «STE 
6B48 1511 : Restore the following offsets. 
seh ig 
0000001C 6848 1514 value_desc = 28 
OO000*C 6848 1515 str_len = 2 
Sse atk Hale ates SH 
class = 
$0000020 Sock 1818 Gotater 2 3 
000000 Q 6B48 1519 data = 
6B48 1520 
05 43 1 1 RSB 
6B49 15 § DEST_B_TO re 
50 50 6CFD 6849 1524 cVTB RO, RO 3: convert 
2 0=«Oo1 6840 13 5 BRE STORE_HFLOAT ¢ go store 
6B4F 15 $ DEST_W_TO_H: 
50 50 6DFD 6B4F 1528 COTWH RO, RO 3; convert 
27,11 6893 1529 BRB STORE _HFLOAT ; go store 
6855 1530 
| 
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17 BASSMAT_ADD = Add 2 arrays giving a thi 6-SEP-1984 BASRTL. SRCIBASMATADD. MAR; 1 
68 1531 DEST_L_TO_H: 
50 39 6EFD 68 2 1 ¢ oa CUTUM RO, RO 3 convert 
ea 68 4 5 STORE _HFLOAT 3 go store 
1328 1535 DEST_F_TO i 
50 50 98FD 6858 1 § Hal RO, RO i convert 
1811 685F 15 STORE _HFLOAT ; go store 
| 6861 1 : DEST_D_T0_H: 
7E 50 70 6861 1540 mOvo RO ; save double 
50 OC AD DO 6864 1541 MOVL = SF $L Save FPCEPD, RO ; pass FP to get scale 
O0000000'GF 16 6868 1 8 JSB G*BASSSS CALE i get scale in RO @ R1 
50 33 0 6 oBek 154 DIVD3 RO, (SP)+ Eat ; descale for dest 
0 32FD 68 154 CVTDH RO, R : convert 
04 687 43 BRB ial went : go store 
6878 1547 DEST_G_T0_H: 
50 50 S6FD 6878 154 CVTGH RO, RO 3 convert 
6B87C 154 ; fall into store 
687C 1550 STORE_HFLOAT: 
4 pO 6B87C 1551 MOVL R10, R4 ; pointer to dest descriptor 
55 O08 AE DO 6B7F 1 MOVL Lower_bnd1+4(SP), RS ; current row (extra longword 
ett 1 zon stack for jsb) 
56 SB DO 6883 1 MOVL R11, R6 3 current column 
28 AE 50 70FD pet : 5 ‘ MOVH RO, DATA+4(SP) 
6888 1 : Redefine the he offsets “94 the call to the STORE macro. The 
6888 1 ; BSBW to here added 4 to the stack 
6888 1 :- 
6888 1 
00000020 6888 1 value_ desc _= 32 
00000020 6888 1 str_lén = 32 
aie oh T 6888 1 dtype = 34 
000000 6888 1 class = 35 
00000024 6888 1 pointer = 36 
00000028 6888 1 data = 4 
rth : STORE 4H inue | 
3 go continue loop 
reo 1 ; : 2 
6C60 1 ; Restore the following offsets. 
6C60 1 ;= 
6C60 1 
0000001C 6C€60 1 value_desc = 28 
000001C oceR 1 str_lén = 28 
OOOOOIE 6C60 1 dtype = 30 
0000001F ote? 1 class = 31 
00000020 6C60 1 pointer = 32 
00000024 6C60 1 ta = 
6C60 1 
05 6C€60 1 RSB 
6(61 1 
6C61 1 END 
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PSECT No. 
00 0.) 
01 1.) 
02 2.) 


1 
Attributes 
NOPIC USR 
NOPIC USR 

PIC USR 


co 
co 
co 
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N ABS 
N ABS 
N REL 
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OSHR NOEXE NORD 
OSHR EXE RD 


NOWRT NOVEC BYTE 
WRT NOVEC BYTE 
RD NOWRT NOVEC LONG 
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Phase Page faults 
Initialization 29 
we Wg processing 116 


Syabol table sort 
Pass 2 


Symbol table output 31 
Psect synopsis output 
Cross-reference output 
Assembler run totals 1381 


The working set — was 2000 pages. 
319544 bytes, (62 

There were 60 
1582 source Lines were read in Pass 1, 


pages of symbol table space allocate 
producin 


1 mi tbs 9 $3338:99 elses Macro v04-00 
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! Performance indicators ! 


jeneeuaeneneenesse eee ee -$ 


CPU Time Elapsed Time 
0:00: 0:00:00.39 
6:8 04.89 


pages) of virtual memory were used to buffer the intermediate cod 


to hold 422 non-local and 909 local symbols. 
object records in Pass 2. 


36 pages of virtual memory were used to define 1 macros. 


Macro Library name 

"$255$DUA28: ppasarh .OBJ JBASRTL.MLB;1 
“$255$DUA28: (SYSLIBISTARLET.MLB;2 
TOTALS (all Libraries) 


wm er meen seoenwe nner nen e ee on + 


493 GETS were required to define 7 macros. 


There were no errors, warnings or information messages. 
MACRO/ENABLE=SUPPRESS1ON/DI SABLE=(GLOBAL , TRACEBACK) /LIS=L1S$:BASMATADD/OBJ=0BJ$:BASMATADD MSRC$:BASMATADD/UPDATE=(ENH$:BASMATADD) ¢L I 
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